home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 726-750 / 745 / bbbbs / bbbbs55.lzh / rexxDoors / Polling_Place.rexx < prev    next >
OS/2 REXX Batch file  |  1992-07-30  |  10KB  |  429 lines
  1. /* $VER: 1.5 Polling_Place.rexx 30 Jul 1992 (30.7.92)
  2.     a Voting Booth for BBBBS by Richard Lee Stockton
  3. */
  4.  
  5. SIGNAL ON BREAK_C
  6. SIGNAL ON BREAK_E
  7. CR='0D'x
  8.  
  9. figarg='s:CONFIG.BBS'
  10. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  11. x=OPEN(f,figarg,'R')
  12. IF x=0 THEN
  13.   DO
  14.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
  15.     EXIT(20)
  16.   END
  17.  
  18. line=STRIP(READLN(f))
  19. sysop=WORD(READLN(f),1)
  20. CALL CLOSE(f)
  21.  
  22. compos=POS('/*',line)
  23. IF compos>0 THEN line=LEFT(line,compos-1)
  24. bbsname=STRIP(line)
  25.  
  26. bbspath=GETCLIP('BBS_path')
  27. polldir=bbspath'rexxDoors/Data/Polls'
  28. CALL MAKEDIR(polldir)
  29.  
  30. PARSE ARG name . . colorflag .
  31. name=STRIP(name)
  32. colorflag=STRIP(colorflag)
  33. IF ~DATATYPE(colorflag,'N') THEN colorflag=1
  34. CALL colors(colorflag)
  35. polls=SHOWDIR(polldir)
  36.  
  37. DO FOREVER
  38.   SAY CR
  39.   SAY bak2||CENTER('  -  Polling_Place.rexx  version 1.5  30 Jul 1992  -  ',75)||def||CR
  40.   CALL ShowPolls()
  41.   com=getinput(1 0 '['pen3'Q'def']uit_To_BBS, ['pen3'S'def']tart_New_Poll or Select_Poll_Number > ')
  42.   com=STRIP(com)
  43.   SELECT
  44.     WHEN com='S' THEN CALL InitPoll()
  45.     WHEN com='X' | com='Q' THEN
  46.       DO
  47.         SAY CR
  48.         SAY 'Returning to the BBS...'CR
  49.         SAY CR
  50.         EXIT
  51.       END
  52.     WHEN DATATYPE(com,'N') THEN CALL do_poll()
  53.     WHEN com='' THEN
  54.       IF getinput(1 1 'Return to BBS? (nY) > ')~='N' THEN EXIT
  55.     OTHERWISE NOP
  56.   END
  57. END
  58. EXIT
  59.  
  60.  
  61. getinput:
  62. PARSE ARG upflag' 'oneflag' 'pline
  63. OPTIONS PROMPT pline
  64. PARSE PULL inarg
  65. inarg=STRIP(inarg)
  66. IF upflag THEN inarg=UPPER(inarg)
  67. IF oneflag THEN inarg=LEFT(inarg,1)
  68. inarg=cleanstring(0':'inarg)
  69. IF LENGTH(inarg)>64 THEN
  70.   DO
  71.     SAY 'Question too long!  Please try again.'CR
  72.     inarg=getinput(0 0 pline)
  73.   END
  74. RETURN inarg
  75.  
  76.  
  77. cleanstring:
  78. PARSE ARG nflag':'cstr
  79. bot=TRIM(XRANGE(,' '))
  80. bot=COMPRESS(bot,'1B'x)
  81. top=XRANGE('7F'x)
  82. IF nflag=1 THEN
  83.   DO
  84.     bot=bot||XRANGE('!','@')'[\]`~{:}'
  85.     cstr=TRANSLATE(UPPER(cstr),' ','_')
  86.   END
  87. cstr=COMPRESS(cstr,bot||top)
  88. IF nflag~=2 THEN cstr=STRIP(cstr)
  89. IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
  90. RETURN cstr
  91.  
  92.  
  93. ShowPolls:
  94. SAY CR
  95. totpolls=WORDS(polls)
  96. DO pfl=1 TO totpolls BY 3
  97.   pfl2=pfl+1
  98.   pfl3=pfl+2
  99.   pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(polls,pfl),21)
  100.   IF pfl2<=totpolls THEN
  101.     pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(polls,pfl2),21)
  102.   IF pfl3<=totpolls THEN
  103.     pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(polls,pfl3),21)
  104.   SAY pfline||CR
  105. END
  106. SAY LEFT('=',75,'=')||CR
  107. RETURN
  108.  
  109.  
  110. InitPoll:
  111. SAY CR
  112. SAY 'You are now starting a new list of questions to be answered by other'CR
  113. SAY 'users. You may enter as many multiple-choice questions as you like.'CR
  114. SAY 'You should limit the number of answers per question to 10 or less.'CR
  115. SAY 'Other than that, you are limited only by the bounds of good taste.'CR
  116. SAY 'A ''None Of The Above'' entry will be added to each list of answers.'CR
  117. SAY 'For a simple Yes/No or True/False question just enter one answer (Yes,'CR
  118. SAY 'No, True, False), and the opposite answer will be filled in for you.'CR
  119. SAY CR
  120. u.=''
  121. u.0=0
  122. p.=''
  123. p.0=0
  124. p.0.0=3
  125. n=LASTPOS('_',name)
  126. p.0.0.0='The_'SUBSTR(name,n+1)'_Poll'
  127. DO i=2 WHILE EXISTS(polldir'/'p.0.0.0)
  128.   p.0.0.0=p.0.0.0'_'i
  129. END
  130. p.0.0.0=STRIP(RIGHT(p.0.0.0,20))
  131. p.0.1=DATE('I')
  132. p.0.1.0=name
  133. p.0.2=0
  134. p.0.2.0=p.0.1
  135. p.0.3=0
  136. p.0.3.0=p.0.1
  137. DO i=1
  138.   DO ii=1
  139.     SAY CR
  140.     SAY 'Enter Question Number' i '  (or blank to quit)'CR
  141.     SAY '  'LEFT('=',64,'=')||CR
  142.     t=getinput(0 0 '> ')
  143.     IF t='' THEN LEAVE i
  144.     SAY t||CR
  145.     IF getinput(1 1 pen3'Is that correct? (nY) > 'def)~='N' THEN LEAVE ii
  146.   END
  147.   p.i.0.0=t
  148.   DO j=1
  149.     DO jj=1
  150.       SAY 'Enter Answer Number' j '  (or blank to quit)'CR
  151.       t=getinput(0 0 '> ')
  152.       IF t='' THEN LEAVE j
  153.       SAY t||CR
  154.       IF getinput(1 1 pen3'Is that correct? (nY) > 'def)~='N' THEN LEAVE jj
  155.     END
  156.     p.i.j=0
  157.     p.i.j.0=t
  158.   END
  159.   IF j=1 THEN
  160.     DO
  161.       p.i.0=''
  162.       p.i.0.0=''
  163.       LEAVE i
  164.     END
  165.   ELSE IF j=2 THEN
  166.     DO
  167.       IF UPPER(p.i.1.0)='NO' THEN line='Yes'
  168.       ELSE IF UPPER(p.i.1.0)='YES' THEN line='No'
  169.       ELSE IF UPPER(p.i.1.0)='TRUE' THEN line='False'
  170.       ELSE IF UPPER(p.i.1.0)='FALSE' THEN line='True'
  171.       ELSE line='None of the above.'
  172.     END
  173.   ELSE IF j>2 THEN
  174.     DO
  175.       jj=j-1
  176.       IF LEFT(UPPER(p.i.jj),17)='NONE OF THE ABOVE' THEN j=j-1
  177.       line='None of the above.'
  178.     END
  179.   p.i.0=j
  180.   p.i.j=0
  181.   p.i.j.0=line
  182. END
  183. i=i-1
  184. IF i<1 THEN
  185.   DO
  186.     p.=''
  187.     RETURN 1
  188.   END
  189. p.0=i
  190. SAY CR
  191. SAY 'This group of questions is currently called' p.0.0.0||CR
  192. IF getinput(1 1 pen3'Is that correct? (nY) > ')='N' THEN
  193.   DO
  194.     SAY 'Please enter a Title, 20 characters or less.'CR
  195.     SAY '  'LEFT('=',20,'=')||CR
  196.     t=getinput(0 0 '> ')
  197.     t=COMPRESS(t,':/;,?*')
  198.     IF t='' THEN t=p.0.0.0
  199.     t=TRANSLATE(t,'_',' ')
  200.     p.0.0.0=t
  201.   END
  202. poll=STRIP(LEFT(p.0.0.0,20))
  203. CALL WritePoll(poll)
  204. polls=SHOWDIR(polldir)
  205. RETURN 0
  206.  
  207.  
  208. do_poll:
  209. IF com<1 | com>WORDS(polls) THEN RETURN
  210. poll=STRIP(WORD(polls,com))
  211. CALL ReadPoll(poll)
  212. IF voted=0 THEN CALL vote()
  213. IF stats() THEN CALL WritePoll(poll)
  214. RETURN
  215.  
  216.  
  217. ReadPoll:
  218. PARSE ARG filename .
  219. CALL CLOSE(f)
  220. x=OPEN(f,polldir'/'filename,'R')
  221. IF x=0 THEN RETURN 1
  222. p.=''
  223. p.0=READLN(f)
  224. IF ~DATATYPE(p.0,'N') THEN RETURN 2
  225. i=0
  226. j=0
  227. DO loop=1
  228.   line=READLN(f)
  229.   IF EOF(f) THEN LEAVE loop
  230.   IF LEFT(line,3)='@@@' THEN
  231.     DO
  232.       IF WORD(line,2)='VOTED' THEN LEAVE loop
  233.       i=i+1
  234.       j=0
  235.       ITERATE loop
  236.     END
  237.   p.i.j=line
  238.   p.i.j.0=READLN(f)
  239.   j=j+1
  240. END
  241. voted=0
  242. u.=''
  243. DO loop=1
  244.   line=READLN(f)
  245.   IF EOF(f) THEN LEAVE loop
  246.   IF name=STRIP(line) THEN voted=1
  247.   u.loop=line
  248. END
  249. CALL CLOSE(f)
  250. IF voted=0 THEN
  251.   DO
  252.     u.0=loop
  253.     u.loop=name
  254.   END
  255. ELSE u.0=loop-1
  256. RETURN 0
  257.  
  258.  
  259. vote:
  260. SAY poll||CR
  261. DO i=1 TO p.0
  262.   SAY pen3'Question:'def p.i.0.0||CR
  263.   IF p.i.0<16 THEN
  264.     DO j=1 TO p.i.0
  265.       SAY pen3||RIGHT(j,7)||def p.i.j.0||CR
  266.     END
  267.   ELSE
  268.     DO pfl=1 TO p.i.0 BY 3
  269.       pfl2=pfl+1
  270.       pfl3=pfl+2
  271.       pfline=pen3||RIGHT(pfl,3)||def LEFT(p.i.pfl.0,21)
  272.       IF pfl2<=p.i.0 THEN
  273.         pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(p.i.pfl2.0,21)
  274.       IF pfl3<=p.i.0 THEN
  275.         pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(p.i.pfl3.0,21)
  276.       SAY pfline||CR
  277.     END
  278.   j=''
  279.   DO WHILE ~DATATYPE(j,'N')
  280.     j=getinput(1 0 'Please Select One > ')
  281.     IF j<1 | j>p.i.0 THEN j=''
  282.   END
  283.   p.i.j=p.i.j+1
  284. END
  285. p.0.2=p.0.2+1
  286. p.0.2.0=DATE('I')
  287. RETURN
  288.  
  289.  
  290. stats:
  291. p.0.3=p.0.3+1
  292. p.0.3.0=DATE('I')
  293. SAY CR
  294. SAY CR
  295. SAY pen3'Title:'def poll||CR
  296. SAY CR
  297. temp=p.0.2
  298. IF temp<1 THEN temp=1
  299. DO i=1 TO p.0
  300.   SAY p.i.0.0||CR
  301.   IF p.i.0<16 THEN
  302.     DO j=1 TO p.i.0
  303.       SAY RIGHT(TRUNC(.05+(p.i.j*100)/temp,1),6)'%  'p.i.j.0||CR
  304.     END
  305.   ELSE
  306.     DO pfl=1 TO p.i.0 BY 3
  307.       pfl2=pfl+1
  308.       pfl3=pfl+2
  309.       pfline=RIGHT(TRUNC(.05+(p.i.pfl*100)/temp,1),4)'% 'LEFT(p.i.pfl.0,19)
  310.       IF pfl2<=p.i.0 THEN
  311.         pfline=pfline RIGHT(TRUNC(.05+(p.i.pfl2*100)/temp,1),4)'% 'LEFT(p.i.pfl2.0,19)
  312.       IF pfl3<=p.i.0 THEN
  313.         pfline=pfline RIGHT(TRUNC(.05+(p.i.pfl3*100)/temp,1),4)'% 'LEFT(p.i.pfl3.0,19)
  314.       SAY pfline||CR
  315.     END
  316.   SAY CR
  317.   CALL getinput(1 1 'Press Return ')
  318.   SAY lineup'                      'lineup||CR
  319. END
  320. SAY poll 'originated by' p.0.1.0 DATE(,p.0.1,'I')||CR
  321. SAY 'This survey has been running' 1+DATE('I')-p.0.1 'days.'CR
  322. SAY p.0.2 'users have responded and the statistics have been read' p.0.3 'times.'CR
  323. SAY CR
  324. IF name=p.0.1.0 | name=sysop THEN
  325.   DO
  326.     temp=''
  327.     IF name=p.0.1.0 THEN temp='This one owned by you. '
  328.     temp=temp'Do you want to delete this poll? (Ny) > '
  329.     IF getinput(1 1 temp)='Y' THEN
  330.       DO
  331.         CALL bbsNewFile.rexx(name polldir'/'p.0.0.0)
  332.         CALL DELETE(polldir'/'p.0.0.0)
  333.         SAY p.0.0.0 'deleted.'CR
  334.         SAY CR
  335.         polls=SHOWDIR(polldir)
  336.         RETURN 0
  337.       END
  338.     SAY CR
  339.   END
  340. ELSE CALL getinput(1 1 'Press Return ')
  341. RETURN 1
  342.  
  343.  
  344. WritePoll:
  345. PARSE ARG filename .
  346. CALL CLOSE(f)
  347. x=OPEN(f,polldir'/'filename,'W')
  348. IF x=0 THEN RETURN 1
  349. DO i=0 TO p.0
  350.   IF i=0 THEN CALL WRITELN(f,p.0)
  351.   ELSE CALL WRITELN(f,'@@@' i)
  352.   DO j=0 TO p.i.0
  353.     CALL WRITELN(f,p.i.j)
  354.     CALL WRITELN(f,STRIP(p.i.j.0))
  355.   END
  356. END
  357. CALL WRITELN(f,'@@@ VOTED')
  358. IF ~DATATYPE(u.0,'N') THEN u.0=0
  359. DO i=1 TO u.0
  360.   CALL WRITELN(f,u.i)
  361. END
  362. CALL CLOSE(f)
  363. RETURN 0
  364.  
  365.  
  366. colors:
  367. ARG onoff
  368. IF onoff THEN
  369.   DO
  370.     lineup='1B'x'M'
  371.     def='';  /* default */
  372.     pen0='';  pen1='';  pen2='';  pen3=''
  373.     pen4='';  pen5='';  pen6='';  pen7=''
  374.     bak0='';  bak1='';  bak2='';  bak3=''
  375.     bak4='';  bak5='';  bak6='';  bak7=''
  376.   END
  377. ELSE
  378.   DO
  379.     pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
  380.     bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
  381.     def='';  lineup=''
  382.   END
  383. RETURN
  384.  
  385.  
  386. BREAK_C:
  387. BREAK_E:
  388. CALL CLOSE(f)
  389. EXIT
  390.  
  391.  
  392. /*
  393. Data Format  (Dates in internal format)
  394.  
  395. p.0        Total Questions in this survey
  396. p.0.0      "3"
  397. p.0.0.0    Overall Survey Title (also filename)
  398. p.0.1      Date this survey started.
  399. p.0.1.0    Survey Originated By
  400. p.0.2      Total users polled in this survey.
  401. p.0.2.0    Date the last user was polled in this survey.
  402. p.0.3      Total users reading responses to this survey.
  403. p.0.3.0    Date the last user read responses to this survey.
  404. "@@@ 1"      
  405. p.1.0      Total possible responses to Question 1
  406. p.1.0.0    Question 1
  407. p.1.1      Response 1 Total
  408. p.1.1.0    Response 1 Text
  409. p.1.2      Response 2 Total
  410. p.1.2.0    Response 2 Text
  411. ...
  412. p.1.n      Response n-3 Total
  413. p.1.n.0    Response n-3 Text
  414. "@@@ 2"
  415. p.2.0      Total possible responses to Question 2
  416. p.2.0.0    Question 2
  417. p.2.1      Response 1 Total
  418. p.2.1.0    Response 1 Text
  419. p.2.2      Response 2 Total
  420. p.2.2.0    Response 2 Text
  421.        etc.
  422. "@@@ VOTED"
  423. u.1        first user polled
  424. ...        list of users who have responded to this survey.
  425. u.[p.0.2]  last user polled
  426. */
  427.  
  428. /* Polling_Place.rexx */
  429.